perm filename C3DPLT.SAI[TMP,LCS] blob sn#131240 filedate 1974-11-18 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	BEGIN "PICPLT"
C00006 ENDMK
C⊗;
BEGIN "PICPLT"
	REQUIRE "GEOMES.HRD[GEM,HE]" SOURCE_FILE;
	DEFINE SUBR="SIMPLE PROCEDURE";
	DEFINE α="COMMENT";
	DEFINE ⊂="BEGIN";
	DEFINE ⊃="END";
	INTEGER BODS,FRIN,CRIN,N;STRING STR;
	REAL ARRAY RIX(4400),RIY(4400),PENUD(4400);

SUBR MKRIN;
	INTEGER CN,CB,CF,CFR,JF;LABEL FOUND;
BEGIN
	FRIN←MKNODE(1);CW$(FRIN)←FRIN;CCW$(FRIN)←FRIN;
	CAR8$(FRIN)←FRIN;CDR8$(FRIN)←FRIN;
	CB←BODS;WHILE BODS≠(CB←CW(CB)) DO BEGIN
	  CF←CB;WHILE CB≠(CF←NFACE(CF)) DO BEGIN
	    JF←JY(CF);CFR←FRIN;
	    WHILE FRIN≠(CFR←CW(CFR)) DO BEGIN
	      IF JY(CFR)=JF THEN BEGIN
		CAR8$(CF)←CAR8(CFR);CAR8$(CFR)←CF;
		CDR8$(CF)←CFR;CDR8$(CAR8(CF))←CF;
		GO TO FOUND;END;
	    END;
	    CN←MKNODE(1);CAR8$(CN)←CF;CDR8$(CN)←CF;
	    CAR8$(CF)←CN;CDR8$(CF)←CN;
	    CW$(CN)←CW(FRIN);CW$(FRIN)←CN;JY(CN)←JF;
	    CCW$(CN)←FRIN;CCW$(CW(CN))←CN;
	    FOUND:
	  END;
	END;
END;

SUBR MKARRS;
	INTEGER CF,CE,CV;
BEGIN
	CF←CRIN;WHILE CRIN≠(CF←CAR8(CB)) DO BEGIN
	  CE←CF;WHILE CF≠(CE←ECW(CE,CF)) DO BEGIN
	    CV←VCW(CE,CF);RIX(N)←XPP(CV);RIY(N)←YPP(CV);
	    RIP(N)=PENUD(K);N←N+2;
	  END;
	END;
END;

SIMPLE PROCEDURE DPYRIN(INTEGER RIN);
BEGIN
	IF CRIN=FRIN THEN RETURN;
	MKARRS;FOR I=1 STEP 3 UNTIL N+2 DO
	IF
END;

SUBR PLOTCOL(INTEGER RIN);
BEGIN
	OUTSTR([???]);
	STR←INSTRL;α???
END;

SUBR TEXTURE;
BEGIN
	STR←INSTRL;α??	 DOTS OR EVENLY SPACED DOTS,LINES,ZIG ZAGS
	KY(CF)←TEX;	α WITH OR WITHOUT EDGES
END;
SUBR FILTXT(INTEGER RIN)
BEGIN
	

SIMPLE FORTRAN PROCEDURE FILL(INTEGER DP,NS,TX);
BEGIN
	DIMENSION Q(1),R(1),NE(1)
	KK=NE(1)
	KJ=2
	DO 4 K=2,KK
	IF(NE(K).NE.3)GO TO 11
	NE(K)=-1
	KJ=K+1
	GO TO 4
11	NE(K)=0
4	CONTINUE
	RLFT=1000
	RT=-1000
	B=RT
	DO 12 K=1,KK
	H=IFIX(Q(K))
	IF(H.LT.RLFT)RLFT=H
	IF(H.GT.RT)RT=H
	IF(H.EQ.B)NE(K)=-1
	B=H
	Q(K)=H
12	R(K)=IFIX(R(K))
	NE(KK+1)=-1
	LRT=RT
	JA=3
124	LEFT=RLFT
51	J=LEFT
42	RJ=J+.001
	JCONT=0
	LEFT=J
	JJ=-1
	ALT=-1000.
200	DO 45 L=2,KK
	IF(NE(L).NE.0)GO TO 45
	IF(MISS(L,RJ,Q))GO TO 45
	H=HGHT(L,RJ,Q,R)
	IF(H.LT.ALT)GO TO 45
	ALT=H
	JJ=L
45	CONTINUE
	IF(JJ)GO TO 43
	JCONT=-1
	LEFT=J
46	JA=3
	JORD=-1
52	KN=Q(JJ)
	KL=Q(JJ-1)
	IF(KN.LT.KL)KN=KL
50	I=J
102	RJ=I+.01
	ALT=HGHT(JJ,RJ,Q,R)
	

END;

SUBR COMMANDS;
BEGIN
	INTEGER CX;
	MKUNIV;GEODPY;
	WHILE TRUE DO BEGIN
	GEOMED;CX←INCHRW;
	IF CX="G" THEN GEOMED;
	IF CX="." THEN BEGIN
	 CRIN←CW(CRIN);DPYRIN(CRIN);END;
	IF CX="T" THEN TEXTURE;
	IF CX="F" THEN FILTXT(CRIN);
	IF CX="P" THEN PLOTCOL(CRIN)
	END;
END;
COMMANDS;
END "PICPLT";